Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/TCPExample/PNL Libraries/MyStartup.p

Text File | 1997-03-20 | 5KB | 228 lines

unit MyStartup;

interface

    uses
        Types,
        MyAssertions;

    var
        current_time: longint;

    type
        StartupMessages = (SMT_None, SMT_Startup, SMT_Generic, SMT_NeedsSystem7, SMT_FailedToInitTCP, SMT_Rest);
        StartupInitProc = function(var msg: integer): OSStatus;
        StartupIdleProc = procedure;
        StartupFinishProc = procedure;

{$ifc not do_debug}
{$definec DidStartup(b) if false then begin end else begin end }
{$definec AssertDidStartup(b) if false then begin end else begin end }
{$elsec}
{$definec DidStartup(b) DidStartupCode(b)}
{$definec AssertDidStartup(b) AssertDidStartupCode(b)}
{$endc}

    procedure InitStartup;
    procedure SetStartup(init: StartupInitProc; idle: StartupIdleProc; idle_period: longint; finish: StartupFinishProc);
    function Startup(var msg: integer): OSStatus;
    procedure IdleStartup;
    procedure FinishStartup;
    procedure FireAtIdle(idle: StartupIdleProc);
{$ifc do_debug}
    procedure DidStartupCode( var check: integer );
    procedure AssertDidStartupCode( check: integer );
{$endc}

implementation

    uses
        Memory, Events, MyMemory;

    type
        EntryRecord = record
            init: StartupInitProc;
            idle: StartupIdleProc;
            idle_period: longint;
            next_idle: longint;
            finish: StartupFinishProc;
        end;
        EntryArray = array[1..10000] of EntryRecord;
        EntryPtr = ^EntryArray;
        EntryHandle = ^EntryPtr;

    const
        idles_max = 100;
        did_startup_check = $5748;

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

    var
        idles: array[1..idles_max] of StartupIdleProc;
        max_idles: longint;
        startup_error: OSStatus;
        entries: EntryHandle;
        entries_count: longint;

{$ifc do_debug}
    procedure DidStartupCode( var check: integer );
    begin
        check := did_startup_check;
    end;

    procedure AssertDidStartupCode( check: integer );
    begin
        Assert( check = did_startup_check );
    end;
{$endc}

    procedure FireAtIdle(idle: StartupIdleProc);
        var
            i: longint;
            found: Boolean;
            hack: StartupIdleProc;
    begin
        found := false;
        for i := 1 to idles_max do begin
            hack := idles[i];
            if hack= nil then begin
                idles[i] := idle;
                if i > max_idles then begin
                    max_idles := i;
                end;
                found := true;
                leave;
            end;
        end;
        if not found then begin
            idle();
        end;
    end;

    procedure SetStartup(init: StartupInitProc; idle: StartupIdleProc; idle_period: longint; finish: StartupFinishProc);
        var
            found: Boolean;
            entry: EntryRecord;
            i: longint;
    begin
        if (startup_error = noErr) & (entries = nil) then begin
            startup_error := MNewHandle(entries, 0);
        end;
        if startup_error = noErr then begin
            found := false;
            for i := 1 to entries_count do begin
                if (entries^^[i].init = init) & (entries^^[i].idle = idle) & (entries^^[i].idle_period = idle_period) & (entries^^[i].finish = finish) then begin
                    found := true;
                    leave;
                end;
            end;
            if not found then begin
                entry.init := init;
                entry.idle := idle;
                entry.idle_period := idle_period;
                entry.next_idle := TickCount;
                entry.finish := finish;
                startup_error := PtrAndHand(@entry, Handle(entries), SizeOf(entry));
                if startup_error = noErr then begin
                    Inc(entries_count);
                end;
            end;
        end;
    end;

    procedure IdleStartup;
        var
            i: longint;
            tmp_hack: StartupIdleProc;
    begin
        current_time := TickCount;
        for i := 1 to entries_count do begin
            tmp_hack := entries^^[i].idle;
            if (tmp_hack <> nil) & (current_time >= entries^^[i].next_idle) then begin
                entries^^[i].next_idle := current_time + entries^^[i].idle_period;
                tmp_hack;
            end;
        end;
        for i := 1 to max_idles do begin
            tmp_hack := idles[i];
            if (tmp_hack<> nil) then begin
                tmp_hack();
                idles[i] := nil;
            end;
        end;
    end;

    procedure InitStartup;
        var
            i: longint;
    begin
        DidStartup( startup_check );
        entries := nil;
        entries_count := 0;
        startup_error := noErr;
        max_idles := 0;
        for i := 1 to idles_max do begin
            idles[i] := nil;
        end;
    end;

    function Startup(var msg: integer): OSStatus;
        var
            i: longint;
            tmp_hack: StartupFinishProc;
            tmp_hack_init: StartupInitProc;
    begin
        AssertDidStartup( startup_check );
        msg := ord(SMT_Startup);
        i := 0;
        while (startup_error = noErr) & (i < entries_count) do begin
            i := i + 1;
            tmp_hack_init := entries^^[i].init;
            if tmp_hack_init <> nil then begin
                msg := ord(SMT_Generic);
                startup_error := tmp_hack_init(msg);
            end;
        end;
        if startup_error <> noErr then begin
            i := i - 1;
            while i > 0 do begin
                tmp_hack := entries^^[i].finish;
                if tmp_hack <> nil then begin
                    tmp_hack;
                end;
                i := i - 1;
            end;
            MDisposeHandle(entries);
            entries_count := 0;
        end;
        if startup_error = noErr then begin
            msg := ord(SMT_None);
        end;
        Startup := startup_error;
    end;

    procedure FinishStartup;
        var
            i: longint;
            tmp_hack: StartupFinishProc;
    begin
        AssertDidStartup( startup_check );
        if entries <> nil then begin
            i := entries_count;
            while i > 0 do begin
                tmp_hack := entries^^[i].finish;
                if tmp_hack <> nil then begin
                    tmp_hack;
                end;
                i := i - 1;
            end;
            MDisposeHandle(entries);
            entries_count := 0;
        end;
    end;

end.